home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE18 / CONSTRUC / PROGMAN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-10-25  |  9.8 KB  |  357 lines
  1. {$X+}
  2. unit ProgMan;
  3. { (c) 1996 by Bob Swart - http://home.pi.net/~drbob/ }
  4. interface
  5. uses
  6.   WinProcs, WinTypes, Classes, SysUtils, Messages, Controls, StdCtrls, ExtCtrls, Graphics;
  7.  
  8. {$IFNDEF WIN32}
  9. Type
  10.   ShortString = String;
  11. {$ENDIF}
  12.  
  13. Type
  14.   TProgMan = class(TWinControl)
  15.     constructor Create(AOwner: TComponent); override;
  16.     destructor  Destroy; override;
  17.     procedure   SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  18.  
  19.     procedure BeginConversation;
  20.     procedure EndConversation;
  21.  
  22.     procedure GetGroups;
  23.  
  24.     procedure CreateNewGroup(Name: ShortString);
  25.     procedure DeleteGroup(Name: ShortString);
  26.     procedure Activate(Group: ShortString);
  27.     procedure Iconize(Group: ShortString);
  28.     procedure Maximize(Group: ShortString);
  29.     procedure Minimize(Group: ShortString);
  30.  
  31.     procedure AddItemToActiveGroup(CommandLine: ShortString;
  32.                                    Name: ShortString);
  33.     procedure DeleteItemFromActiveGroup(Item: ShortString);
  34.  
  35.   private
  36.     _About: ShortString;
  37.     PMWindow: HWnd;
  38.     Connected: Boolean;
  39.     ClosedByPM: Boolean;
  40.  
  41.     procedure InitiateConversation;
  42.     procedure TerminateConversation;
  43.  
  44.     procedure WMDDEData(var Msg: TWMDDE_Data);
  45.               message wm_DDE_Data;
  46.     procedure WMDDEAck(var Msg: TWMDDE_Ack);
  47.               message wm_DDE_Ack;
  48.     procedure WMDDETerminate(var Msg: TWMDDE_Terminate);
  49.               message wm_DDE_Terminate;
  50.  
  51.     procedure SendMacroString(macro: PChar; size: Byte);
  52.  
  53.   protected
  54.     FAbout: ShortString;
  55.     FBitmap: TImage;
  56.     FActive: Boolean;
  57.     FGroups: TStringList;
  58.     FOnDDEdata: TNotifyEvent;
  59.  
  60.     procedure SetActive(Value: Boolean); virtual;
  61.     procedure SetGroups(Value: TStringList); virtual;
  62.  
  63.   published
  64.     property About: ShortString read FAbout write _About;
  65.     property Active: Boolean read FActive write SetActive;
  66.     property Groups: TStringList read FGroups write SetGroups;
  67.  
  68.     property OnDDEdata: TNotifyEvent read FOnDDEdata write FOnDDEdata;
  69.   end {TProgMan};
  70.  
  71.   procedure Register;
  72.  
  73. implementation
  74. {$IFDEF WIN32}
  75.   {$R PROGMAN.D32}
  76. {$ELSE}
  77.   {$R PROGMAN.D16}
  78. {$ENDIF}
  79. uses
  80.   Forms, Dialogs;
  81.  
  82. {$IFDEF WIN32}
  83. Type
  84.   PDDEData = ^TDDEData;
  85.   TDDEData = packed record
  86.       Flags: Word;
  87.       cfFormat: SmallInt;
  88.       Value: array[0..0] of Char {instead of Byte};
  89.     end;
  90. {$ENDIF}
  91.  
  92.   constructor TProgMan.Create(AOwner: TComponent);
  93.   begin
  94.     inherited Create(AOwner);
  95.     Height := 24;
  96.     Width := 24;
  97.     PMWindow := 0;
  98.     FActive := False;
  99.     Connected := False;
  100.     ClosedByPM := False;
  101.     FGroups := TStringList.Create;
  102.     FBitmap := TImage.Create(Self);
  103.     FBitmap.Parent := Self;
  104.     FBitmap.Name := 'bitmap';
  105.     FBitmap.Align := alNone;
  106.     FBitmap.Autosize := True;
  107.     {$IFDEF WIN32}
  108.     FBitmap.Picture.Bitmap.
  109.       LoadFromResourceName(HInstance,'TPROGMAN');
  110.     {$ELSE}
  111.     FBitmap.Picture.Bitmap.Handle := LoadBitmap(HInstance,'TPROGMAN');
  112.     {$ENDIF}
  113.     FAbout := 'TProgMan (c) 1996 by Bob Swart (aka Dr.Bob - http://home.pi.net/~drbob/)'
  114.   end {Create};
  115.  
  116.   destructor TProgMan.Destroy;
  117.   begin
  118.     FGroups.Free;
  119.     FBitmap.Free;
  120.     inherited Destroy
  121.   end {Destroy};
  122.  
  123.   procedure TProgMan.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  124.   begin
  125.     inherited SetBounds(ALeft, ATop, 24, 24)
  126.   end {SetBounds};
  127.  
  128.   procedure TProgMan.SetActive(Value: Boolean);
  129.   begin
  130.     if Value then BeginConversation
  131.              else EndConversation;
  132.     FActive := Value
  133.   end {SetActive};
  134.  
  135.   procedure TProgMan.GetGroups;
  136.   var Item: TAtom;
  137.   begin
  138.     if Connected then
  139.     begin
  140.       Item := GlobalAddAtom('Groups');
  141.       if not PostMessage(PMWindow, wm_DDE_Request, Handle,
  142.       {$IFDEF WIN32}
  143.              PackDDElParam(wm_DDE_Request, CF_TEXT, Item))
  144.       {$ELSE}
  145.              MakeLong(CF_TEXT, Item))
  146.       {$ENDIF}
  147.       then
  148.         GlobalDeleteAtom(Item)
  149.     end
  150.   end {GetGroups};
  151.  
  152.   procedure TProgMan.SetGroups(Value: TStringList);
  153.   begin
  154.     ShowMessage('Error: SetGroups not supported...')
  155.   end {SetGroups};
  156.  
  157.   procedure TProgMan.WMDDEData(var Msg: TWMDDE_Data);
  158.   { respond to a DDE data delivery message }
  159.   {$IFDEF WIN32}
  160.   var DataHandle,DataTopic: PUINT;
  161.   {$ENDIF}
  162.   var Data: PDDEData;
  163.   begin
  164.     inherited;
  165.   {$IFDEF WIN32}
  166.     if UnpackDDElParam(Msg.Msg, Msg.PackedVal, DataHandle, DataTopic) and
  167.       (DataHandle <> nil) then
  168.          Data := PDDEData(GlobalLock(DataHandle^))
  169.     else Data := nil; { in Win32 design mode... }
  170.   {$ELSE}
  171.     Data := PDDEData(GlobalLock(Msg.Data));
  172.   {$ENDIF}
  173.     FGroups.Clear;
  174.     if Data <> nil then
  175.       FGroups.SetText(Data^.Value);
  176.   {$IFDEF WIN32}
  177.     if not PostMessage(PMWindow, wm_DDE_Ack, Handle, Msg.PackedVal) then
  178.       FreeDDElParam(Msg.Msg, Msg.PackedVal);
  179.   {$ENDIF}
  180.     if Assigned(FOnDDEdata) then FOnDDEdata(Self)
  181.   end {WMDDEData};
  182.  
  183.  
  184.   procedure TProgMan.CreateNewGroup(Name: ShortString);
  185.   var Len: Byte absolute Name;
  186.   begin
  187.     Name := '[CreateGroup(' + Name + ')]'#0;
  188.     SendMacroString(@Name[1],Len)
  189.   end {CreateNewGroup};
  190.  
  191.   procedure TProgMan.DeleteGroup(Name: ShortString);
  192.   var Len: Byte absolute Name;
  193.   begin
  194.     Name := '[DeleteGroup(' + Name + ')]'#0;
  195.     SendMacroString(@Name[1],Len)
  196.   end {DeleteGroup};
  197.  
  198.   procedure TProgMan.Activate(Group: ShortString);
  199.   var Len: Byte absolute Group;
  200.   begin
  201.     Group := '[ShowGroup(' + Group + ',1)]'#0;
  202.     SendMacroString(@Group[1],Len)
  203.   end {Activate};
  204.  
  205.   procedure TProgMan.Iconize(Group: ShortString);
  206.   var Len: Byte absolute Group;
  207.   begin
  208.     Group := '[ShowGroup(' + Group +',2)]'#0;
  209.     SendMacroString(@Group[1],Len)
  210.   end {Iconize};
  211.  
  212.   procedure TProgMan.Maximize(Group: ShortString);
  213.   var Len: Byte absolute Group;
  214.   begin
  215.     Group := '[ShowGroup(' + Group +',3)]'#0;
  216.     SendMacroString(@Group[1],Len)
  217.   end {Maximize};
  218.  
  219.   procedure TProgMan.Minimize(Group: ShortString);
  220.   var Len: Byte absolute Group;
  221.   begin
  222.     Group := '[ShowGroup(' + Group +',6)]'#0;
  223.     SendMacroString(@Group[1],Len)
  224.   end {Minimize};
  225.  
  226.   procedure TProgMan.AddItemToActiveGroup(CommandLine: ShortString;
  227.                                           Name: ShortString);
  228.   var Len: Byte absolute CommandLine;
  229.   begin
  230.     if Name <> '' then
  231.       CommandLine := '[AddItem(' + CommandLine + ',' + Name +')]'#0
  232.     else { command-line }
  233.       CommandLine := '[AddItem(' + CommandLine +')]'#0;
  234.     SendMacroString(@CommandLine[1],Len)
  235.   end {AddItemToActiveGroup};
  236.  
  237.   procedure TProgMan.DeleteItemFromActiveGroup(Item: ShortString);
  238.   var Len: Byte absolute Item;
  239.   begin
  240.     Item := '[DeleteItem(' + Item +')]'#0;
  241.     SendMacroString(@Item[1],Len)
  242.   end {DeleteItemFromActiveGroup};
  243.  
  244.  
  245.   procedure TProgMan.BeginConversation;
  246.   begin
  247.     if not Connected then InitiateConversation
  248.   end {BeginConversation};
  249.  
  250.   procedure TProgMan.EndConversation;
  251.   begin
  252.     if Connected then TerminateConversation
  253.   end {EndConversation};
  254.  
  255.  
  256.   procedure TProgMan.InitiateConversation;
  257.   var ApplicationName, Topic: TAtom;
  258.   begin
  259.     ApplicationName := GlobalAddAtom('PROGMAN');
  260.     Topic := GlobalAddAtom('PROGMAN');
  261.     if SendMessage(HWnd(-1), wm_DDE_Initiate, Handle,
  262.     {$IFDEF WIN32}
  263.            PackDDElParam(wm_DDE_Initiate, ApplicationName, Topic)) = 0
  264.     {$ELSE}
  265.            MakeLong(ApplicationName, Topic)) = 0
  266.     {$ENDIF}
  267.     then
  268.     begin
  269.       GlobalDeleteAtom(ApplicationName);
  270.       GlobalDeleteAtom(Topic)
  271.     end
  272.   end {InitiateConversation};
  273.  
  274.   procedure TProgMan.TerminateConversation;
  275.   begin
  276.     PostMessage(PMWindow, wm_DDE_Terminate, Handle, LongInt(0));
  277.     PMWindow := 0
  278.   end {Terminate};
  279.  
  280.   procedure TProgMan.WMDDEAck(var Msg: TWMDDE_Ack);
  281.   { respond to a DDE acknowledgement message }
  282.   {$IFDEF WIN32}
  283.   var DataHandle,DataTopic: PUINT;
  284.   Const MaxSize = 9;
  285.   var Name: Array[0..MaxSize] of Char;
  286.   {$ENDIF}
  287.   begin
  288.     inherited;
  289.     if not Connected then { sent message }
  290.     begin
  291.       Connected := True;
  292.       PMWindow := Msg.PostingApp;
  293.       {$IFDEF WIN32}
  294.       FillChar(Name,MaxSize+1,#0);
  295.       if UnpackDDElParam(Msg.Msg, Msg.PackedVal, DataHandle, DataTopic) then
  296.       begin
  297.         GlobalGetAtomName(DataTopic^,@Name[0],MaxSize);
  298.         Name[MaxSize] := #0;
  299.       { MessageBox(GetFocus,Name,Name,MB_OK); }
  300.       end;
  301.       {$ENDIF}
  302.       if Connected then GetGroups
  303.     end
  304.   {$IFDEF WIN32s}
  305.     else { posted message }
  306.     begin
  307.       if UnpackDDElParam(Msg.Msg, Msg.PackedVal, DataHandle, DataTopic) and
  308.         (DataHandle <> nil) then
  309.         FreeDDElParam(Msg.Msg, Msg.PackedVal)
  310.     end
  311.   {$ENDIF}
  312.   end {WMDDEAck};
  313.  
  314.   procedure TProgMan.WMDDETerminate(var Msg: TWMDDE_Terminate);
  315.   { respond to a DDE terminate message }
  316.   begin
  317.     inherited;
  318.     if (PMWindow <> 0) and not ClosedByPM then { we're not closing }
  319.     begin
  320.       ClosedByPM := True;
  321.       PostMessage(PMWindow, wm_DDE_Terminate, Handle, LongInt(0))
  322.     end;
  323.     Connected := False
  324.   end {WMDDETerminate};
  325.  
  326.   procedure TProgMan.SendMacroString(macro: PChar; size: Byte);
  327.   var MacroHandle: Cardinal;
  328.       MacroPChar: PChar;
  329.   begin
  330.     MacroHandle := GlobalAlloc(gmem_moveable OR gmem_DDEShare, size+1);
  331.     if MacroHandle <> 0 then
  332.     begin
  333.       MacroPChar := PChar(GlobalLock(MacroHandle));
  334.       if MacroPChar <> nil then
  335.       begin
  336.         StrCopy(MacroPChar, macro);
  337.         GlobalUnLock(MacroHandle);
  338.         if not PostMessage(PMWindow, wm_DDE_Execute, Handle,
  339.         {$IFDEF WIN32}
  340.                PackDDElParam(wm_DDE_Execute, 0, MacroHandle))
  341.         {$ELSE}
  342.                MakeLong(0, MacroHandle))
  343.         {$ENDIF}
  344.         then
  345.           GlobalFree(MacroHandle)
  346.       end
  347.       else
  348.         GlobalFree(MacroHandle)
  349.     end
  350.   end {SendMacroString};
  351.  
  352.   procedure Register;
  353.   begin
  354.     RegisterComponents('Dr.Bob', [TProgMan])
  355.   end;
  356. end.
  357.